home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / grafpix.zip / GRAF-PIX.2X next >
Text File  |  1982-11-12  |  19KB  |  496 lines
  1. 1 '*****************************************
  2. 2 '*                                       *
  3. 3 '*         G R A F  -  P I X             *
  4. 4 '*                                       *
  5. 5 '*  A Graphics Program     Version 1.0   *
  6. 6 '*        by  Read G. Gilgen             *
  7. 7 '*  U.W. Labs for Recorded Instruction   *
  8. 8 '*  Madison, WI 53706     608-262-1408   *
  9. 9 '*                                       *
  10. 10 '*     (c) 1982 by Board of Regents     *
  11. 11 '*    University of Wisconsin System    *
  12. 12 '*                                      *
  13. 13 '****************************************
  14. 14 '
  15. 15 '
  16. 16 '
  17. 20 '***************************************
  18. 22 '* NOTICE:  This program may be copied *
  19. 24 '*   freely, so long as the copyright  *
  20. 26 '*   information and this notice are   *
  21. 28 '*   included unchanged.               *
  22. 30 '***************************************
  23. 35 '
  24. 36 '
  25. 37 '
  26. 100 CLEAR ,,1024:CLS:KEY OFF
  27. 105 REM program to check for default monitor
  28. 110 DEF SEG=0
  29. 115 IF (PEEK(&H410) AND &H30)=&H30 THEN GOSUB 6000
  30. 120 DIM CLRA$(20)
  31. 125 SCREEN 1
  32. 130 COLOR 0,1
  33. 135 LOCATE 13,16:PRINT "GRAF-PIX"
  34. 137 LOCATE 15,9:PRINT "Created by Read Gilgen"
  35. 140 LOCATE 19,7:PRINT "(c) 1982  Board of Regents"
  36. 142 LOCATE 20,5:PRINT "University of Wisconsin System"
  37. 145 FOR PAUSE=1 TO 2000:NEXT PAUSE
  38. 150 CLS:DEF SEG=&H40: POKE &H17, (PEEK(&H17) AND &HFFBF) +64:DEF SEG=&HB000:          POKE 3998,24:  ' SETS UPPER CASE FROM KEYBOARD
  39. 155 COLOR 0,1
  40. 160 PRINT "REMOVE GRAF-PIX DISK AND INSERT"
  41. 165 PRINT "IBM-FORMATTED STORAGE DISK."
  42. 170 PRINT:PRINT "(PRESS ANY KEY TO CONTINUE)":ANS$=INPUT$(1)
  43. 175 CLS:PRINT "Do you wish to:"
  44. 180 PRINT "   1.  Edit an existing graphics file"
  45. 185 PRINT "   2.  Create a new graphics file"
  46. 190 PRINT "   3.  Delete a graphics file"
  47. 195 PRINT "   4.  Print Graf-Pix documentation"
  48. 200 PRINT "   5.  Exit from Graf-Pix"
  49. 205 ON ERROR GOTO 365
  50. 210 ANS$=INPUT$(1)
  51. 215 IF ANS$="1" THEN GOTO 270 ELSE IF ANS$="2" THEN GOTO 315 ELSE IF ANS$="3"         THEN GOTO 220 ELSE IF ANS$="4" THEN GOTO 5000 ELSE IF ANS$="5"                  THEN GOTO 400 ELSE GOTO 150
  52. 220 CLS:PRINT "Graphics files on this disk are:"
  53. 225 PRINT:FILES "*.GRF":PRINT
  54. 230 PRINT :PRINT "Type COMPLETE filename to delete:"
  55. 235 INPUT FILENAME$
  56. 240 ON ERROR GOTO 255
  57. 245 CLS:PRINT "Delete ";FILENAME$;"?  (Y/N)";
  58. 250 ANS$=INPUT$(1):IF ANS$="Y" OR ANS$="y" THEN GOTO 260 ELSE IF ANS$<>"N" AND        ANS$<>"n" THEN GOTO 245 ELSE GOTO 150
  59. 255 CLS:PRINT "Deletion NOT completed":FOR PAUSE=1 TO 2000: NEXT PAUSE:               RESUME 220
  60. 260 KILL FILENAME$
  61. 265 CLS: PRINT FILENAME$ " has been deleted.":FOR PAUSE = 1 TO 2000 :                 NEXT PAUSE : GOTO 150
  62. 270 CLS:PRINT "Graphics files on this disk are:"
  63. 275 PRINT: FILES "*.grf":PRINT
  64. 280 PRINT "Please type filename to edit: ":INPUT PICTURENAME$
  65. 285 ON ERROR GOTO 300
  66. 290 CLS:DEF SEG=&HB800: BLOAD PICTURENAME$,0
  67. 295 GOTO 500
  68. 300 CLS:PRINT "Error in loading file.  Try again? (Y/N)"
  69. 305 ANS$=INPUT$(1)
  70. 310 IF ANS$="N" OR ANS$="n" THEN RESUME 150 ELSE IF ANS$="Y" OR ANS$="y"              THEN RESUME 270 ELSE GOTO 300
  71. 315 CLS: PRINT "Existing graphics files are:":ON ERROR GOTO 340
  72. 320 PRINT:FILES "*.grf":PICTURENAME$=""
  73. 325 PRINT:PRINT "Please type the new filename:":PRINT
  74. 330 ANS$=INPUT$(1)
  75. 335 IF ANS$=CHR$(13) THEN GOTO 355 ELSE IF ANS$="." THEN GOTO 355                     ELSE IF ANS$=CHR$(8) THEN GOTO 370 ELSE IF ANS$=CHR$(27) THEN GOTO 150          ELSE GOTO 345
  76. 340 PRINT:PRINT "(No files yet created . . .)":RESUME 325
  77. 345 PICTURENAME$=PICTURENAME$+ANS$:PRINT ANS$;
  78. 350 GOTO 330
  79. 355 TAG$=".grf":PICTURENAME$=PICTURENAME$+TAG$
  80. 360 GOTO 380
  81. 365 CLS:PRINT "FILE NOT AVAILABLE":PRINT:RESUME 175
  82. 370 PICTURENAME$=LEFT$(PICTURENAME$,(LEN(PICTURENAME$)-1))
  83. 375 PRINT CHR$(29);CHR$(32);CHR$(29);:GOTO 330
  84. 380 CLS:PRINT "The new filename is ";PICTURENAME$
  85. 385 PRINT "OK?  (Y/N): ";
  86. 390 ANS$=INPUT$(1):IF ANS$="Y" OR ANS$="y" THEN GOTO 395 ELSE GOTO 315
  87. 395 CLS:GOTO 500
  88. 400 GOTO 4000
  89. 405 '
  90. 406 '
  91. 500 REM Turtle Grahpics Program
  92. 501 '
  93. 505 ON ERROR GOTO 3000
  94. 510 BND=3    'Boundary color (lines, etc.); default to WHITE
  95. 515 BKGRD=0  'Background default to BLACK
  96. 520 PLT=1    'Pallete; default to CYAN, MGTA, WHITE
  97. 525 CLRA$(1)="Blue":CLRB$(1)="Cyan ":CLRC$(1)="Mgnta":CLRD$(1)="White"
  98. 530 CLRA$(0)="Black":CLRB$(0)="Green":CLRC$(0)="Red  ":CLRD$(0)="Brown"
  99. 535 COLOR (BKGRD),(PLT)
  100. 540 OLDA=160:OLDB=100
  101. 545 NEWA=OLDA:NEWB=OLDB
  102. 550 AMT=6
  103. 555 HELP=0
  104. 560 KEY (1) ON:ON KEY (1) GOSUB 1300     'help menu
  105. 565 KEY (3) ON:ON KEY (3) GOSUB 1400     'circle
  106. 570 KEY (4) ON : ON KEY (4) GOSUB 1700   'fill area
  107. 575 KEY (6) ON: ON KEY (6) GOSUB 1800    'box
  108. 580 KEY (8) ON: ON KEY (8) GOSUB 1900    'end program
  109. 585 KEY(7) ON: ON KEY(7) GOSUB 750       'increase/decrease cursor movement
  110. 590 KEY (11) ON: ON KEY (11) GOSUB 760   'cursor movements
  111. 595 KEY (12) ON: ON KEY (12) GOSUB 765
  112. 600 KEY (13) ON: ON KEY (13) GOSUB 770
  113. 605 KEY (14) ON: ON KEY (14) GOSUB 775
  114. 610 KEY (5) ON: ON KEY (5) GOSUB 1000     'input text
  115. 615 KEY (2) ON: ON KEY (2) GOSUB 2000    'set new color parameters
  116. 620 KEY (9) ON:ON KEY (9) GOSUB 800
  117. 625 KEY (10) ON:ON KEY (10) GOSUB 900
  118. 630 IF DOIT=0 THEN GOTO 645
  119. 635 LINE (OLDA,OLDB)-(NEWA,NEWB),BND
  120. 636 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),BND
  121. 640 DOIT=0
  122. 645 DIAG$=INKEY$
  123. 650 IF DIAG$<>"" THEN GOSUB 700
  124. 655 GOTO 630
  125. 660 '
  126. 661 '
  127. 700 REM Diagonal cursor movements
  128. 701 '
  129. 705 IF DIAG$=CHR$(0)+CHR$(71) THEN GOTO 710 ELSE GOTO 715
  130. 710 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  131. 711 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0:NEWA=NEWA-AMT:NEWB=NEWB-AMT:DOIT=1
  132. 712 RETURN
  133. 715 IF DIAG$=CHR$(0)+CHR$(79) THEN GOTO 720 ELSE GOTO 725
  134. 720 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  135. 721 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0:NEWA=NEWA-AMT:NEWB=NEWB+AMT:DOIT=1
  136. 722 RETURN
  137. 725 IF DIAG$=CHR$(0)+CHR$(73) THEN GOTO 730 ELSE GOTO 735
  138. 730 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  139. 731 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0:NEWA=NEWA+AMT:NEWB=NEWB-AMT:DOIT=1
  140. 732 RETURN
  141. 735 IF DIAG$=CHR$(0)+CHR$(81) THEN GOTO 740 ELSE GOTO 745
  142. 740 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  143. 741 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0:NEWA=NEWA+AMT:NEWB=NEWB+AMT:DOIT=1
  144. 742 RETURN
  145. 745 RETURN
  146. 750 IF AMT=6 THEN AMT=1 ELSE IF AMT=1 THEN AMT=6:RETURN
  147. 755 RETURN
  148. 760 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  149. 761 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0:NEWB=NEWB-AMT:DOIT=1:RETURN
  150. 765 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  151. 766 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0:NEWA=NEWA-AMT:DOIT=1:RETURN
  152. 770 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  153. 771 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0:NEWA=NEWA+AMT:DOIT=1:RETURN
  154. 775 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  155. 776 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0:NEWB=NEWB+AMT:DOIT=1:RETURN
  156. 780 '
  157. 781 '
  158. 800 REM Erase the line and have a new point
  159. 801 '
  160. 805 PASTA=OLDA:PASTB=OLDB
  161. 810 IF DONE=0 THEN GOTO 840
  162. 815 IF NEWA<> OLDA AND NEWB<>OLDB THEN GOTO 860
  163. 820 IF NEWA>OLDA THEN OLDA=OLDA+2
  164. 825 IF NEWB>OLDB THEN OLDB=OLDB+1
  165. 830 IF NEWA<OLDA THEN OLDA=OLDA-2
  166. 835 IF NEWB<OLDB THEN OLDB=OLDB-1
  167. 840 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  168. 841 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0
  169. 845 OLDA=NEWA:OLDB=NEWB
  170. 850 DONE=0
  171. 855 RETURN
  172. 860 LINE (OLDA,OLDB)-(NEWA,NEWB),0
  173. 861 LINE (OLDA+1,OLDB)-(NEWA+1,NEWB),0
  174. 865 LINE (OLDA,OLDB)-(OLDA,OLDB),BND
  175. 866 LINE (OLDA+1,OLDB)-(OLDA+1,OLDB),BND
  176. 870 GOTO 820
  177. 875 '
  178. 876 '
  179. 900 REM Draw the line permanently and have a new point
  180. 901 '
  181. 905 PASTA=OLDA:PASTB=OLDB
  182. 910 OLDA=NEWA:OLDB=NEWB
  183. 915 DONE=1
  184. 920 RETURN
  185. 925 '
  186. 926 '
  187. 1000 REM ROUTINE TO ALLOW TEXT PRINTING
  188. 1001 '
  189. 1005 LOCATE 25,1
  190. 1010 PRINT "      Esc = Return to Graphics";SPC(9);
  191. 1015 LINE (OLDA,OLDB)-(NEWA,NEWB),0:                                                   LOCATE (INT(NEWB/8)),(INT((NEWA/8)+1)),1,6,7
  192. 1020 CHRS=1
  193. 1025 TEXT$=INPUT$(1)
  194. 1030 IF TEXT$=CHR$(27) OR TEXT$=CHR$(13) THEN GOTO 1080 ELSE GOTO 1035
  195. 1035 IF TEXT$=CHR$(8) THEN GOTO 1040 ELSE GOTO 1060
  196. 1040 CHRS=CHRS-1
  197. 1045 LOCATE (INT(NEWB/8)),(INT((NEWA/8)+CHRS)):PRINT " "
  198. 1050 LOCATE (INT(NEWB/8)),(INT((NEWA/8)+CHRS))
  199. 1055 GOTO 1025
  200. 1060 PRINT TEXT$
  201. 1065 CHRS=CHRS+1
  202. 1070 LOCATE (INT(NEWB/8)),(INT((NEWA/8)+CHRS))
  203. 1075 GOTO 1025
  204. 1080 HELP=0
  205. 1085 FOR BLANK=1 TO 39:LOCATE 25,BLANK:PRINT CHR$(32);:NEXT BLANK
  206. 1090 RETURN
  207. 1095 '
  208. 1096 '
  209. 1100 REM ROUTINE TO SAVE THE PICTURE
  210. 1101 '
  211. 1105 LOCATE 25,1:PRINT SPC(39);
  212. 1110 LOCATE 25,1:PRINT "Save/Print this as ";PICTURENAME$;"?  (Y/N)";
  213. 1115 ANS$=INPUT$(1)
  214. 1120 IF ANS$="Y" OR ANS$="y" THEN GOTO 1180 ELSE IF ANS$<>"N" AND ANS$<>"n"            THEN GOTO 1105 ELSE GOTO 1125
  215. 1125 LOCATE 25,1:PRINT SPC(39);
  216. 1130 LOCATE 25,1:PRINT "What name:  ";
  217. 1135 LOCATE 25,13:GOSUB 2200
  218. 1140 PICTURENAME$=""
  219. 1145 FOR SCAN=1 TO 8
  220. 1150   IF MID$(INPT$,SCAN,1)="." THEN GOTO 1165 ELSE GOTO 1155
  221. 1155   PICTURENAME$=PICTURENAME$+MID$(INPT$,SCAN,1)
  222. 1160 NEXT SCAN
  223. 1165 TAG$=".grf"
  224. 1170 PICTURENAME$=PICTURENAME$+TAG$
  225. 1175 GOTO 1105
  226. 1180 LOCATE 25,1
  227. 1185 PRINT SPC(39);
  228. 1190 DEF SEG= &HB800
  229. 1195 BSAVE PICTURENAME$,0,&H4000
  230. 1200 RETURN
  231. 1205 '
  232. 1206 '
  233. 1300 REM Help Menu on Line 25
  234. 1301 '
  235. 1305 KEY OFF
  236. 1310 LOCATE 25,1
  237. 1315 IF HELP=0 THEN GOTO 1320 ELSE GOTO 1325
  238. 1320 PRINT "1=Help 2=Clr 3=Circle 4=AreaFill 5=Text";
  239. 1325 IF HELP = 1 THEN GOTO 1330 ELSE GOTO 1335
  240. 1330 PRINT "6=Box 7=Cursor 8=EndPgm 9=Erase 10=Line";
  241. 1335 IF HELP = 2 THEN GOTO 1340 ELSE GOTO 1345
  242. 1340 PRINT SPC(39);
  243. 1345 IF HELP=0 THEN HELP =1 ELSE IF HELP=1 THEN HELP=2 ELSE IF HELP=2                  THEN HELP=0
  244. 1350 RETURN
  245. 1355 '
  246. 1356 '
  247. 1400 REM Create a circle
  248. 1401 '
  249. 1405 ASPECT=.8330001
  250. 1410 START=0
  251. 1415 ENDS=0
  252. 1420 PI=3.141593
  253. 1425 LOCATE 25,1:PRINT "Radius =  ";SPC(29);
  254. 1430 LOCATE 25,13:GOSUB 2200
  255. 1435 RD=VAL(INPT$):IF RD=<0 THEN GOTO 1425
  256. 1440 LOCATE 25,1:PRINT "Full Circle?  (Y/N)";SPC(20);
  257. 1445 LOCATE 25,23:GOSUB 2200:FULL$=INPT$
  258. 1450 IF FULL$="Y" OR FULL$="y" THEN GOTO 1515 ELSE IF FULL$<>"N" AND FULL$<>"n"        THEN GOTO 1440
  259. 1455 ANGLE$="2=Rt 1.5=Btm 1=Lft .5=Top"
  260. 1460 LOCATE 25,1:PRINT "Start: ";ANGLE$;SPC(7);
  261. 1465 LOCATE 25,34:GOSUB 2200:START$=INPT$
  262. 1470 START=VAL(START$):IF START=<0 THEN GOTO 1460
  263. 1475 LOCATE 25,1:PRINT "End: ";ANGLE$;SPC(9);
  264. 1480 LOCATE 25,33:GOSUB 2200:ENDS$=INPT$
  265. 1485 ENDS=VAL(ENDS$):IF ENDS=<0 THEN GOTO 1475
  266. 1490 START=(START*PI):ENDS=(ENDS*PI)
  267. 1495 LOCATE 25,1:PRINT "Draw radius lines? (Y/N)";SPC(15);
  268. 1500 LOCATE 25,26:GOSUB 2200:RLINS$=INPT$
  269. 1505 IF RLINS$="Y" OR RLINS$="y" THEN GOTO 1510 ELSE IF RLINS$="N" OR RLINS$="n"       THEN GOTO 1515 ELSE GOTO 1495
  270. 1510 START=-(START):ENDS=-(ENDS)
  271. 1511 DONE=1
  272. 1515 LOCATE 25,1:PRINT "Aspect:  N=Normal  T=Tall  F=Flat      ";
  273. 1520 LOCATE 25,36:GOSUB 2200:VIEW$=INPT$
  274. 1525 IF VIEW$="T" OR VIEW$="t" THEN GOTO 1550 ELSE IF VIEW$="F" OR VIEW$= "f"          THEN GOTO 1530 ELSE GOTO 1570
  275. 1530 LOCATE 25,1:PRINT "Flat Range:  .01 to .8";SPC(17);
  276. 1535 LOCATE 25,26:GOSUB 2200:ASPECT$=INPT$
  277. 1540 ASPECT=VAL(ASPECT$):IF ASPECT<.01 OR ASPECT>.83 THEN GOTO 1530
  278. 1545 GOTO 1570
  279. 1550 LOCATE 25,1:PRINT "Tall Range:  .9 to 50(?)";SPC(15);
  280. 1555 LOCATE 25,30:GOSUB 2200:ASPECT$=INPT$
  281. 1560 ASPECT=VAL(ASPECT$):IF ASPECT<.84 OR ASPECT>100 THEN GOTO 1550
  282. 1565 GOTO 1570
  283. 1570 REM Print the circle
  284. 1575 IF START=0 AND ENDS=0 THEN GOTO 1590
  285. 1580 CIRCLE (NEWA,NEWB),RD,BND,START,ENDS,ASPECT
  286. 1581 CIRCLE (NEWA+1,NEWB),RD,BND,START,ENDS,ASPECT
  287. 1585 GOTO 1595
  288. 1590 CIRCLE(NEWA,NEWB),RD,BND,,,ASPECT
  289. 1591 CIRCLE(NEWA+1,NEWB),RD,BND,,,ASPECT
  290. 1595 LOCATE 25,1:PRINT SPC(39);
  291. 1600 RETURN
  292. 1605 '
  293. 1606 '
  294. 1700 REM Fill in an area
  295. 1701 '
  296. 1705 LOCATE 25,1:PRINT "Is cursor within closed area. (Y/N)    ";
  297. 1710 LOCATE 25,37:GOSUB 2200:READY$=INPT$
  298. 1715 IF READY$="Y" OR READY$="y" THEN GOTO 1725 ELSE GOTO 1785
  299. 1720 LOCATE 25,1:PRINT SPC(39);
  300. 1725 LOCATE 25,1:PRINT "Color? 0=";CLRA$(BKGRD);" 1=";CLRB$(PLT);" 2=";                CLRC$(PLT);" 3=";CLRD$(PLT);
  301. 1730 LOCATE 25,38:GOSUB 2200:CLR$=INPT$
  302. 1735 FILLCOLOR=VAL(CLR$)
  303. 1740 IF FILLCOLOR <0 OR FILLCOLOR>3 THEN GOTO 1725
  304. 1745 GOSUB 800    'erase cursor
  305. 1750 LOCATE 25,1:PRINT SPC(39);
  306. 1755 LOCATE 25,1:PRINT "Boundary? 1=";CLRB$(PLT);" 2=";CLRC$(PLT);" 3=";               CLRD$(PLT);
  307. 1760 LOCATE 25,36:GOSUB 2200:BOUNDS$=INPT$
  308. 1765 BND=VAL(BOUNDS$)
  309. 1770 IF BND<1 OR BND>3 THEN GOTO 1750
  310. 1775 PAINT (NEWA,NEWB),FILLCOLOR,BND
  311. 1780 IF FILLCOLOR = 0 THEN BND=3 ELSE BND=FILLCOLOR
  312. 1785 LOCATE 25,1:PRINT SPC(39);
  313. 1790 DONE=1
  314. 1795 RETURN
  315. 1798 '
  316. 1799 '
  317. 1800 REM Draw box
  318. 1801 '
  319. 1805 LOCATE 25,1:PRINT "Do you want the box filled? (Y/N)";SPC(6);
  320. 1810 LOCATE 25,35:GOSUB 2200:FILLED$=INPT$
  321. 1815 IF FILLED$="N" OR FILLED$="n" THEN GOTO 1830                                      ELSE IF FILLED$<>"Y" AND FILLED$<>"y" THEN GOTO 1805
  322. 1820 GOSUB 800
  323. 1825 LINE (PASTA,PASTB)-(NEWA,NEWB),BND,BF
  324. 1826 LINE (PASTA+1,PASTB)-(NEWA+1,NEWB),BND,BF
  325. 1830 GOSUB 800
  326. 1835 LINE (PASTA,PASTB)-(NEWA,NEWB),BND,B
  327. 1836 LINE (PASTA+1,PASTB)-(NEWA+1,NEWB),BND,B
  328. 1840 LOCATE 25,1:PRINT SPC(39);
  329. 1845 HELP=0
  330. 1850 DONE=1
  331. 1855 RETURN
  332. 1860 '
  333. 1861 '
  334. 1900 REM End the Program
  335. 1901 '
  336. 1905 LOCATE 25,1:PRINT "(ESC)ape (S)ave (P)rint (E)nd-not save ";
  337. 1910 LOCATE 25,37:ANS$=INPUT$(1)
  338. 1915 IF ANS$="E" OR ANS$="e" THEN GOTO 1925 ELSE IF ANS$="S" OR ANS$="s"               THEN GOSUB 1100 ELSE IF ANS$=CHR$(27) THEN GOTO 1930 ELSE IF ANS$="P"           OR ANS$="p" THEN GOTO 1940 ELSE GOTO 1905
  339. 1920 GOTO 1905
  340. 1925 CLS: GOTO 150
  341. 1930 LOCATE 25,1:PRINT SPC(39);
  342. 1935 RETURN
  343. 1940 GOSUB 1100
  344. 1945 GOTO 4000
  345. 1950 RETURN
  346. 1951 '
  347. 1955 '
  348. 2000 REM Change the Color Parameters
  349. 2001 '
  350. 2005 LOCATE 25,1:PRINT SPC(39);
  351. 2010 LOCATE 25,1:PRINT "Line Color= ";
  352. 2015 IF BND=1 THEN PRINT CLRB$(PLT); ELSE IF BND=2 THEN PRINT CLRC$(PLT);              ELSE IF BND=3 THEN PRINT CLRD$(PLT);
  353. 2020 LOCATE 25,20:PRINT "Change? (Y/N)";
  354. 2025 LOCATE 25,35:CHNG$=INPUT$(1)
  355. 2030 IF CHNG$="Y" OR CHNG$="y" THEN GOTO 2035 ELSE GOTO 2045
  356. 2035 IF BND=1 THEN BND=2 ELSE IF BND=2 THEN BND=3 ELSE IF BND=3 THEN BND=1
  357. 2040 GOTO 2005
  358. 2045 LOCATE 25,1:PRINT SPC(39);
  359. 2050 LOCATE 25,1:PRINT "Other changes?  (Y/N)";
  360. 2055 LOCATE 25,30:MORE$=INPUT$(1)
  361. 2060 IF MORE$="Y" OR MORE$="y" THEN GOTO 2070
  362. 2065 LOCATE 25,1:PRINT SPC(39);:RETURN
  363. 2070 LOCATE 25,1:PRINT SPC(39);
  364. 2075 LOCATE 25,1:PRINT "Clrs 0(Grn,Rd,Brn) 1(Cyan,Mgta,Wht)";
  365. 2080 LOCATE 25,37:PALETTE$=INPUT$(1)
  366. 2085 PLT=VAL(PALETTE$)
  367. 2090 IF PLT<0 OR PLT>1 THEN GOTO 2070
  368. 2095 LOCATE 25,1:PRINT SPC(39);
  369. 2100 LOCATE 25,1:PRINT "Bkgrnd 0(Blk) 1(Blue) 2-15(Others)";
  370. 2105 LOCATE 25,36:GOSUB 2200:BACKGROUND$=INPT$
  371. 2110 BKGRD=VAL(BACKGROUND$)
  372. 2115 IF BKGRD<0 OR BKGRD>15 THEN GOTO 2095
  373. 2120 COLOR (BKGRD),(PLT)
  374. 2125 LOCATE 25,1:PRINT SPC(39);
  375. 2130 RETURN
  376. 2135 '
  377. 2136 '
  378. 2200 REM routine to eliminate carriage return on input
  379. 2201 '
  380. 2205 INPT$=""
  381. 2210 X$=INPUT$(1)
  382. 2215 IF X$=CHR$(13) THEN RETURN ELSE GOTO 2220
  383. 2220 IF X$=CHR$(8) THEN GOTO 2225 ELSE GOTO 2240
  384. 2225 INPT$=LEFT$(INPT$,(LEN(INPT$)-1))
  385. 2230 PRINT CHR$(29);CHR$(32);CHR$(29);
  386. 2235 GOTO 2210
  387. 2240 INPT$=INPT$+X$
  388. 2245 PRINT X$;
  389. 2250 GOTO 2210
  390. 2255 '
  391. 2256 '
  392. 3000 REM Error handling section
  393. 3001 '
  394. 3005 LOCATE 25,1:PRINT SPC(39);
  395. 3010 LOCATE 25,1:PRINT "Error #";ERR;"in line";ERL;"  Any Key:";
  396. 3015 LOCATE 25,39
  397. 3020 ANS$=INPUT$(1)
  398. 3025 RESUME 1900
  399. 3030 RESUME 500
  400. 3035 '
  401. 3036 '
  402. 4000 REM GRAPHICS DUMP ROUTINE
  403. 4001 '
  404. 4010 LOCATE 25,1: PRINT "Insert Graf-Pix Disk.  (Press any key)";
  405. 4020 ANS$=INPUT$(1)
  406. 4030 SYSTEM
  407. 4035 '
  408. 4036 '
  409. 5000 REM   Print Documentation
  410. 5005 '
  411. 5010 CLS:SCREEN 0:WIDTH 80
  412. 5015 ON ERROR GOTO 5200
  413. 5016 PRINT "MAKE SURE THE GRAF-PIX PROGRAM DISK"
  414. 5017 PRINT "IS IN DRIVE A.  HIT ANY KEY WHEN READY
  415. 5018 ANS$=INPUT$(1)
  416. 5019 CLS
  417. 5020 CLOSE #2: OPEN "GP.DOC" FOR INPUT AS #2
  418. 5025 PRINT:PRINT"MAKE SURE THAT YOUR PRINTER IS ON AND LOADED WITH CONTINUOUS FORM PAPER.
  419. 5030 PRINT"ALIGN THE PRINT HEAD WITH THE TOP OF THE FORM AND
  420. 5035 PRINT" SET THE PRINTER TO PRINT 66 LINES PER PAGE.
  421. 5040 PRINT"THE PRINTING ROUTINE WILL TAKE ABOUT 3 MINUTES AT 80 CPS.
  422. 5045 PRINT"DO YOU WISH TO PROCESS WITH PRINTING NOW (Y/N)? ";
  423. 5050 Q$=INKEY$:IF Q$="" THEN 5050
  424. 5055 IF Q$<>"Y" AND Q$<>"y" THEN GOTO 5155
  425. 5060 ON ERROR GOTO 5230
  426. 5065 LPRINT " "; '*** tests for whether printer is on
  427. 5070 LOCATE 25,1:PRINT">>> Printing Documentation <<<  (Press CTRL+<Home> to terminate.)";SPACE$(13);:LOCATE 24,1
  428. 5075 '
  429. 5076 '    - printing routine -
  430. 5080 INDENT=8
  431. 5085 FOR J=1 TO 100
  432. 5090   LPRINT:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
  433. 5095   FOR I=1 TO 55
  434. 5098     IF EOF(2) THEN CLOSE #2:GOTO 5145
  435. 5100     LINE INPUT #2,P$
  436. 5105     PRINT P$
  437. 5110     IF LEFT$(P$,1)="\" THEN 5135
  438. 5115     LPRINT SPACE$(INDENT);:LPRINT P$
  439. 5120     Q$=INKEY$:IF  Q$<>"" THEN IF ASC(RIGHT$(Q$,1))=119 THEN 5150
  440. 5130   NEXT I
  441. 5135   LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
  442. 5140 NEXT J
  443. 5145 FOR K=I TO 55:LPRINT:NEXT K
  444. 5150 '     - terminate printing -
  445. 5155 CLOSE #2:CLS:SCREEN 1:GOTO 150
  446. 5160 FOR SPACES=1 TO 12
  447. 5165 LPRINT
  448. 5170 NEXT SPACES
  449. 5175 RETURN
  450. 5180 '
  451. 5200 CLS:PRINT "Make sure the Graf-Pix disk"
  452. 5205 PRINT "  is in the logged drive.  Strike"
  453. 5210 PRINT "  any key when ready."
  454. 5215 ANS$=INPUT$(1)
  455. 5220 RESUME 5000
  456. 5225 '
  457. 5230 CLS:PRINT "Make sure the printer is ready . . ."
  458. 5235 PRINT "(Strike any key when ready.)"
  459. 5240 ANS$=INPUT$(1)
  460. 5245 RESUME 5060
  461. 5250 '
  462. 5251 '
  463. 6000 REM Program to transfer control to COLOR/GRAPHICS adapter
  464. 6001 '
  465. 6005 KEY OFF:CLS
  466. 6010 COLOR 31:PRINT"CAUTION!!!":COLOR 7
  467. 6015 PRINT:PRINT "IF YOU DO NOT HAVE A COLOR ADAPTER"
  468. 6020 PRINT "CARD INSTALLED, DO NOT USE THIS"
  469. 6025 PRINT "PROGRAM OR YOU'LL HAVE TO START ALL"
  470. 6030 PRINT "OVER AGAIN!!
  471. 6035 PRINT:PRINT "DO YOU WISH TO PROCEED?  (Y/N)"
  472. 6040 A$=INPUT$(1)
  473. 6045 GOSUB 6070
  474. 6050 CLS
  475. 6055 WIDTH 80: DEF SEG=0: A=PEEK(&H410): POKE &H410, (A AND &HCF) OR &H20
  476. 6060 WIDTH 40: SCREEN 1: SCREEN 0: LOCATE ,,1,6,7
  477. 6065 RETURN
  478. 6070 REM CHECK FOR ANSWER
  479. 6075 IF A$="Y" OR A$="y" THEN RETURN
  480. 6080 WIDTH 80:CLS:SYSTEM
  481. 6085 END
  482. 7001 '*****************************************
  483. 7002 '*                                       *
  484. 7003 '*         G R A F  -  P I X             *
  485. 7004 '*                                       *
  486. 7005 '*        A Graphics Program             *
  487. 7006 '*        by  Read G. Gilgen             *
  488. 7007 '*  U.W. Labs for Recorded Instruction   *
  489. 7008 '*  Madison, WI 53706     608-262-1408   *
  490. 7009 '*                                       *
  491. 7010 '*      (c) 1982 Board of Regents        *
  492. 7011 '*    University of Wisconsin System     *
  493. 7012 '*                                       *
  494. 7014 '*****************************************
  495. y of Wisconsin System     *
  496. 7012 '*                                       *